home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / comunic / twft099b.zip / TWTRADE.PAS < prev   
Pascal/Delphi Source File  |  1993-06-07  |  60KB  |  1,773 lines
  1. Unit TwTrade;
  2.  
  3. {
  4. Copyright (C) 1993 by David Myers.  All rights reserved.  Personal
  5. copying and use of this code permitted.  This source cannot be
  6. sold or distributed for more than the cost of media.
  7. }
  8.  
  9. Interface
  10. Uses
  11.   Crt, FlyCom, FParser, TwBuffer, TwScr, TwAnsi, TwLine;
  12.  
  13. Type
  14.   Real3 = Array[1 ..3] of real;
  15.   Int3 = ARRAY[1 ..3] of integer;
  16. { a record to be used perhaps for future expansion }
  17.   PortType = RECORD
  18.     Name : string;
  19.     Loc : string[5];
  20.     Class : integer;
  21.     Buy,Sell : real3;
  22.   END;
  23.  
  24. Var
  25.   DefaultBuy, DefaultSell, DefaultFactor : real;
  26.   DeltaFactorOffer, DeltaFactorPsp : real;
  27.   { leave these parameters (buy and sell margins, trading factor)
  28.     visible so that external code can alter them }
  29.  
  30. FUNCTION isdigit( var c : char) : boolean;
  31.  
  32. Procedure CIMCapture;
  33.  
  34. Procedure Trade;
  35.  
  36. Procedure Steal;
  37.  
  38. Procedure FivePointSteal;
  39.  
  40. Procedure MultiSteal;
  41.  
  42. Implementation
  43.  
  44. Const
  45.    StrProd:array[1 .. 3] of string = ('Fuel Ore','Organics','Equipment');
  46.    ClassStr:array[0 .. 9] of string = ('','BBS','BSB','SBB','SSB','SBS',
  47.                                        'BSS','SSS','BBB','BBB');
  48. Type
  49.   StealType = (STWO,SFIVE,SMULTI);
  50.  
  51. Procedure Process_Port_Pair(var s1, s2 : string;
  52.                             var NTrade, Buy1, Buy2,
  53.                                 Haggle1, Haggle2,
  54.                                 P1sells, P2sells : integer);
  55. {
  56.   VARIABLES:
  57.  
  58.   INPUT
  59.  
  60.   S1 - 3 character string that defines what Port 1 buys and sells,
  61.        such as 'BSB' or 'SSB'.
  62.  
  63.   S2 - 3 character string that defines what Port 2 buys and sells.
  64.  
  65.   OUTPUT
  66.  
  67.   S1 - 3 character string where products that are not traded have
  68.        the following letter replacement: 'S' -> 'Y', 'B' -> 'X'.
  69.        So if a 'BSB' port is paired with a 'BSS' port, the
  70.        output would be 'XYB' and 'XYS' respectively.
  71.  
  72.   S2 - same for Port 2.
  73.  
  74.   NTRADE - Total Number of products that will be traded between
  75.            the two ports.
  76.  
  77.   Buy1 - Total number of products that will be bought from Port 1
  78.  
  79.   Buy2 - Total number of products that will be bought from Port 2
  80.  
  81.   Haggle1 - NTrade + any additional number of products that Port 1
  82.             attempts to sell.
  83.   Haggle2 - NTrade + any additional number of products that Port 2
  84.             attempts to sell.
  85.   P1sells - total # of products that Port 1 sells.
  86.   P2sells - total # of products that Port 2 sells.
  87. }
  88. var
  89.   i,x : integer;
  90.  
  91. BEGIN
  92.   Ntrade := 0;
  93.   Buy1 := 0;
  94.   Buy2 := 0;
  95.   Haggle1 := 0;
  96.   Haggle2 := 0;
  97.   P1sells := 0;
  98.   P2sells := 0;
  99.   for i := 1 to length(S1) do begin
  100.     s1[i] := UpCase(s1[i]);
  101.     If s1[i] = 'S' then
  102.     Inc(P1sells);
  103.   end;
  104.   for i := 1 to length(S2) do begin
  105.     s2[i] := UpCase(s2[i]);
  106.     If s2[i] = 'S' then
  107.     Inc(P2sells);
  108.   end;
  109.   x := Length(S1);
  110.   If (Length(S2) < x) then
  111.     x := Length(S2);
  112.   if x > 3 then
  113.     x := 0;
  114.   i := 1;
  115.   While ( i <= x) do begin
  116.     if (s1[i] <> s2[i]) then begin
  117.       Inc(NTrade);
  118.       Inc(Haggle1);
  119.       Inc(Haggle2);
  120.       if (s1[i] = 'S') then
  121.         Inc(Buy1)
  122.       else Inc(Buy2);
  123.     end
  124.     else begin { s1[i] = s2[i] }
  125.       if (s1[i] = 'S') then begin
  126.         s1[i] := 'Y';
  127.         s2[i] := 'Y';
  128.         Inc(Haggle1);
  129.         Inc(Haggle2);
  130.       end
  131.       else begin
  132.         s1[i] := 'X';
  133.         s2[i] := 'X';
  134.       end;
  135.     end;
  136.     Inc(i);
  137.   end;
  138. END;
  139.  
  140. FUNCTION isdigit( var c : char) : boolean;
  141. { If the character is a digit, returns TRUE, otherwise returns FALSE }
  142. BEGIN
  143.   If ((c >= '0') and (c <= '9')) THEN
  144.     isdigit := TRUE
  145.   ELSE isdigit := FALSE;
  146. END;
  147.  
  148. Function str_to_tw_int(s : string) : integer;
  149. { converts TW integers to Pascal integers }
  150. Var
  151.   subtotal,j : integer;
  152.  
  153. BEGIN
  154.   subtotal := 0;
  155.   For j := 1 to length(s) do
  156.     BEGIN
  157.       if isdigit(s[j]) THEN
  158.       subtotal := 10*subtotal + ord(s[j]) - ord('0');
  159.     END;
  160.   str_to_tw_int := subtotal;
  161. END;
  162.  
  163. FUNCTION pct_to_real(S: string) : real;
  164. { converts Psychic Probe percentages to real fractions }
  165. Var
  166.   j : integer;
  167.   subtotal : integer;
  168.   t : real;
  169.  
  170. BEGIN
  171.   subtotal := 0;
  172.   For j := 1 to length(s)-1 do
  173.     BEGIN
  174.       if isdigit(s[j]) THEN
  175.       subtotal := 10*subtotal + ord(s[j]) - ord('0');
  176.     END;
  177.     t := subtotal*0.0001;
  178.     If ((t < 0.8) or (t > 1.0)) then
  179.       t := 1.0;
  180.     pct_to_real := t;
  181. END;
  182.  
  183. FUNCTION pct_in_string(var P : ParseType) : real;
  184. { finds the percentage in the parsed Psychic Probe string and
  185.   converts it to a fraction }
  186. var
  187.   j : integer;
  188.   t : real;
  189.  
  190. BEGIN
  191.   t := 1.0;
  192.   for j := 0 to P.count - 1 do
  193.     If isdigit(P.s[j][1]) THEN
  194.       t := pct_to_real(P.s[j]);
  195.   pct_in_string := t;
  196. END;
  197.  
  198. FUNCTION Product_Num(s : string) : integer;
  199. var
  200.   i, n : integer;
  201. BEGIN
  202.   n := 0;
  203.   if length(s) > 0 THEN BEGIN
  204.     if MatchToken(s,'Fuel') then n := 1;
  205.     if MatchToken(s,'Organics') then n := 2;
  206.     if MatchToken(s,'Equipment') then n := 3;
  207.   END;
  208.   Product_Num := n;
  209. END;
  210.  
  211.  
  212. Procedure CIMCapture;
  213. { sets up a capture file that TWASSIST can use }
  214. { in TWFT 0.95a and up, this routine uses a separate capture
  215.   buffer from the open, close, and save commands of the user
  216.   buffer. GetALine was modified so that buffer 2 never sees
  217.   ANSI commands, so that now you can CIM an ANSI screen and
  218.   TWASSIST will never know the difference. }
  219. var
  220.   toks : integer;
  221.   tradestr, inputstr : string;
  222.   Ptrade : ParseType;
  223.   Loopit : boolean;
  224.   X,Y : Integer;
  225.  
  226. BEGIN
  227.   TradeStr := ' '+#9+#10+#13;
  228.   Loopit := TRUE;
  229.   If DiskBuff2 and (NOT NotOpen2) then begin
  230.   { if our capture buffer 2 is open, warn user to close and save it first }
  231.     SaveScreen(X,Y);
  232.     TextColor(Yellow);
  233.     TextBackground(Magenta);
  234.     GoToXY(10,9);  Write('                           ');
  235.     GoToXY(10,10); Write(' Save Open Buffer 2 First! ');
  236.     GoToXY(10,11); Write('                           ');
  237.     Delay(2000);
  238.     NormalVideo;
  239.     RestoreScreen;
  240.     GotoXY(X,Y);
  241.   end
  242.   else begin
  243.   OpenBuffer2;
  244.   Async_Send('V');
  245.   REPEAT
  246.     GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  247.   UNTIL ((NOT Loopit) or MatchToken(Ptrade.s[toks-1],'=Help)?'));
  248.   if Loopit then begin
  249.     Delay(1000);
  250.     Async_Send('G');
  251.     REPEAT
  252.       GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  253.     UNTIL ((NOT Loopit) or MatchToken(Ptrade.s[toks-1],'=Help)?'));
  254.     if Loopit then begin
  255.       Delay(1000);
  256.       Async_Send('K');
  257.       REPEAT
  258.         GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  259.       UNTIL ((NOT Loopit) or MatchToken(Ptrade.s[toks-1],'=Help)?'));
  260.       If Loopit then begin { #3 }
  261.         Delay(1000);
  262.         Async_Send('C');
  263.         REPEAT
  264.           GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  265.         UNTIL ((NOT Loopit) or MatchToken(Ptrade.s[toks-1],'?'));
  266.         if Loopit then begin { #4 }
  267.           Delay(1000);
  268.           Async_Send('X');
  269.           REPEAT
  270.             GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  271.           UNTIL ((NOT Loopit) or MatchToken(Ptrade.s[toks-1],'?'));
  272.           If Loopit then begin { #5 }
  273.             Delay(1000);
  274.             Async_Send_String('╚╔╩╦╠═');
  275.             REPEAT
  276.               GetALine(toks,tradestr,inputstr,':',Ptrade,Loopit);
  277.             UNTIL ((NOT Loopit) or MatchToken(Ptrade.s[toks-1],':'));
  278.             If Loopit then begin { #6 }
  279.               Delay(1000);
  280.               Async_Send('R');
  281.               REPEAT
  282.                 GetALine(toks,tradestr,inputstr,':',Ptrade,Loopit);
  283.               UNTIL ((NOT Loopit) or MatchToken(Ptrade.s[toks-1],':'));
  284.               If Loopit then begin
  285.                 Delay(1000);
  286.                 Async_Send('I');
  287.                 REPEAT
  288.                   GetALine(toks,tradestr,inputstr,':',Ptrade,Loopit);
  289.                 UNTIL ((NOT Loopit) or MatchToken(Ptrade.s[toks-1],':'));
  290.                 If Loopit then begin
  291.                   Delay(1000);
  292.                   Async_Send('Q');
  293.                   REPEAT
  294.                     GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  295.                   UNTIL ((NOT Loopit) or MatchToken(Ptrade.s[toks-1],'?'));
  296.                   If Loopit then begin
  297.                     SaveBuffer2;
  298.                     Delay(1000);
  299.                     Async_Send('Q');
  300.                   end; { Loopit #9 }
  301.                 end; { Loopit #8 }
  302.               end; { Loopit #7 }
  303.             end; { Loopit #6 }
  304.           end; { Loopit #5 }
  305.         end; { Loopit #4 }
  306.       end; { Loopit #3 }
  307.     end; { Loopit #2 }
  308.   end; { Loopit #1 }
  309.   If (NOT Loopit) then
  310.     SaveBuffer2;
  311.   end;
  312. END;
  313.  
  314. Procedure StealAtAPort(var Loop, HasStolen : boolean; Holds : integer;
  315.  TypeOfSteal : StealType);
  316. Var
  317.   toks,i : integer;
  318.   tstr,istr,S : string;
  319.   P : parsetype;
  320.   temp1, temp2, temp3 : boolean;
  321.   X, Y : integer;
  322.  
  323. BEGIN
  324.     Tstr := ' '+#8+#9+#10+#13;
  325.     If HasStolen then begin
  326.       HasStolen := FALSE;
  327.       REPEAT
  328.         GetALine(toks,tstr,istr,'?',P,Loop);
  329.       UNTIL ((NOT Loop) or MatchToken(P.s[toks-1],'=Help)?'));
  330.     end;
  331.     If Loop then begin {#1}
  332.       Delay(1000);
  333.       X := WhereX; Y := WhereY;
  334.       SelectWindow(1);
  335.       TextBackground(Cyan);
  336.       ClrScr;
  337.       Write(' Stealing Equipment. ');
  338.       NormalVideo;
  339.       SelectWindow(2);
  340.       GoToXY(X,Y);
  341.       Async_Send('P');
  342.       REPEAT
  343.         GetALine(toks,tstr,istr,'?',P,Loop);
  344.         temp1 := MatchToken(P.s[toks-1],'?');
  345.       UNTIL ((NOT Loop) or temp1);
  346.       If Loop then begin {#2}
  347.         Delay(1000);
  348.         Async_Send('R');
  349.         REPEAT
  350.           GetALine(toks,tstr,istr,']',P,Loop);
  351.           temp1 := MatchToken(P.s[toks-1],'[Pause]');
  352.         UNTIL ((NOT Loop) or temp1);
  353.         If Loop then begin {#3}
  354.           Delay(1000);
  355.           Async_Send(#13);
  356.           REPEAT
  357.             GetALine(toks,tstr,istr,')',P,Loop);
  358.             temp1 := MatchToken(P.s[toks-1],'(?=Help)');
  359.           UNTIL ((NOT Loop) or temp1);
  360.           If Loop then begin {#4}
  361.             Delay(1000);
  362.             Async_Send('S');
  363.             REPEAT
  364.               GetALine(toks,tstr,istr,'?',P,Loop);
  365.               temp1 := MatchToken(P.s[toks-1],'?');
  366.             UNTIL ((NOT Loop) or temp1);
  367.             If Loop then begin {#5}
  368.               Delay(1000);
  369.               Async_Send('3');
  370.               REPEAT
  371.                 GetALine(toks,tstr,istr,'?',P,Loop);
  372.                 temp1 := MatchToken(P.s[toks-1],'swipe?');
  373.               UNTIL ((NOT Loop) or temp1);
  374.               If Loop then begin {#6}
  375.                 Str(Holds,S);
  376.                 S := S + #13;
  377.                 Delay(1000);
  378.                 Async_Send_String(S);
  379.                 REPEAT
  380.                 UNTIL Async_tx_empty;
  381.                 REPEAT
  382.                   GetALine(toks,tstr,istr,'!.',P,Loop);
  383.                   X := WhereX; Y := WhereY;
  384.                   SelectWindow(1);
  385.                   TextBackground(Cyan);
  386.                   ClrScr;
  387.                   Write(' Steal Successful? ');
  388.                   NormalVideo;
  389.                   SelectWindow(2);
  390.                   GoToXY(X,Y);
  391.                   temp1 := MatchToken(P.s[toks-1],'Busted!');
  392.                   temp2 := MatchToken(P.s[toks-1],'Success!');
  393.                   temp3 := MatchToken(P.s[toks-1],'point(s).');
  394.                 UNTIL ((NOT Loop) or temp1 or temp2 or temp3);
  395.                 If Loop then begin {#7}
  396.                   If temp1 then begin
  397.                     Loop := FALSE;
  398.                     Alarm;
  399.                   end;
  400.                   if temp2 or temp3 then begin
  401.                     REPEAT
  402.                       GetALine(toks,tstr,istr,'?',P,Loop);
  403.                       temp1 := MatchToken(P.s[toks-1],'=Help)?');
  404.                       X := WhereX; Y := WhereY;
  405.                       SelectWindow(1);
  406.                       TextBackground(Cyan);
  407.                       ClrScr;
  408.                       Write(' End of Steal? ');
  409.                       NormalVideo;
  410.                       SelectWindow(2);
  411.                       GoToXY(X,Y);
  412.                     UNTIL ((NOT Loop) or temp1);
  413.                   end;
  414.                 end; { if Loop #7 }
  415.               end; { if Loop #6 }
  416.             end; { if Loop #5 }
  417.           end; { if Loop #4 }
  418.         end; { if Loop #3}
  419.       end; { if Loop #2}
  420.       if Loop then begin
  421.       { ------------------- }
  422.         X := WhereX; Y := WhereY;
  423.         TextColor(White);
  424.         TextBackground(Cyan);
  425.         SelectWindow(1);
  426.         ClrScr;
  427.         If (TypeOfSteal = SMulti) then
  428.           Write('      === ALT 6 - MultiSteal Steal/Sell. ALT Q Quits. ===  ');
  429.         If (TypeOfSteal = SFive) then
  430.           Write('      === ALT 5- 5 Point Steal/Sell. ALT Q Quits. ===      ');
  431.         If (TypeOfSteal = STwo) then
  432.           Write('      === ALT S- Tradewars Steal/Sell. ALT Q Quits. ===    ');
  433.         NormalVideo;
  434.         SelectWindow(2);
  435.         GoToXY(X,Y);
  436.       end; { if loop for exit code.}
  437.     end; { if Loop #1}
  438. END;
  439.  
  440. { an experimental 5 point algo, gutting the older trade algo }
  441. Procedure FivePointTrade(  PortBuy : string;
  442.                         Port4Sale : integer;
  443.                         var BP5P, FO5P : integer;
  444.                         Hold : Int3;
  445.                         MaxCount : integer;
  446.                         var Loopit : boolean);
  447.  
  448. {
  449.   experimental 5 point trading algo..
  450.  
  451.   VARIABLES:
  452.  
  453.   INPUT:
  454.  
  455.   PortBuy - processed 3 character string of the 'XYS' variety.
  456.   Port4Sale - The number of products the port has for sale.
  457.   BP5P - 5 point best price.
  458.   FO5P - port offer used to determine best price.
  459.   Hold - array of number of Holds of Fuel Ore, Org., and Eq. traded.
  460.   MaxCount - # of Haggles required for this port
  461.   Loopit - TRUE
  462.  
  463.   OUTPUT:
  464.  
  465.   Loopit - FALSE if ALT-Q pressed.
  466.  
  467.   LOCAL:
  468.  
  469.   TradeStr, InputStr, Ptrade, toks : GetALine vars.
  470.   HasSold - Boolean used to flag whether port has bought product.
  471.   PCount - # of Haggles so far.
  472.   PBuyCount - # of items for sale so far.
  473.   CurrentProduct - current product being traded.
  474.   OldOffer - the previous port offer
  475.   PortOffer - the current port offer
  476.   OurOffer - our current offer.
  477.   OldBid - our first offer.
  478.   Delta - positive difference between PortOffer and OldOffer.
  479.   Done - FALSE while macro and port haggling over price of product.
  480.   ProbePct - fraction of best price returned by Psychic Probe
  481.  
  482. }
  483.  
  484. Var
  485.  
  486.   TradeStr, InputStr, S : string;
  487.   toks : integer;
  488.   PTrade : ParseType;
  489.   HasSold : boolean;
  490.   PCount, PBuyCount : integer;
  491.   CurrentProduct : integer;
  492.   OldOffer,PortOffer,OurOffer : integer;
  493.   OldBid : integer;
  494.   Done : boolean;
  495.   temp1, temp2, tempb1, tempb2, tempb3, tempb4, tempb5 : boolean;
  496.   Delta : integer;
  497.   DeltaH : real;
  498.   ProbePct : real;
  499.   X,Y : integer;
  500.  
  501. BEGIN
  502.       Tradestr := ' '+#9+#10+#13;
  503.       Delay(1000);
  504.       Async_Send('P');
  505.       REPEAT
  506.         GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  507.       UNTIL ((NOT Loopit) or MatchToken(Ptrade.s[toks-1],'?'));
  508.       Delay(500);
  509.       Async_Send('T');
  510.       HasSold := FALSE;
  511.       PCount := 0;
  512.       PBuyCount := 0;
  513.       REPEAT { Have You exhausted this port? }
  514.       REPEAT
  515.         GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  516.       UNTIL ((NOT Loopit) or MatchToken(Ptrade.s[toks-2],'sell') or
  517.               MatchToken(Ptrade.s[toks-2],'buy'));
  518.       If ((NOT HasSold) and MatchToken(Ptrade.s[toks-2],'buy') and
  519.       (Port4Sale < MaxCount)) THEN
  520.         MaxCount := Port4Sale; { take care of empty holds situation }
  521.       If (MatchToken(Ptrade.s[toks-2],'buy') and Loopit) THEN BEGIN
  522.         Currentproduct := Product_Num(Ptrade.s[4]);
  523.           S := '0'+#13;
  524.           Async_Send_String(S);
  525.           Inc(PCount);
  526.           Inc(PBuyCount);
  527.       END; { If 'buy' }
  528.  
  529.       If (MatchToken(Ptrade.s[toks-2],'sell') and Loopit) THEN BEGIN
  530.         Currentproduct := Product_Num(Ptrade.s[4]);
  531.         IF (Currentproduct <> 3) THEN BEGIN
  532.           S := '0'+#13;
  533.           Async_Send_String(S);
  534.         END
  535.         ELSE BEGIN
  536.         S := '';
  537.         S := #13;
  538.         Async_Send_String(S);
  539.         OldOffer := 0;
  540.         Done := FALSE;
  541.         { add a loop here }
  542.         While ((NOT Done) and Loopit) do BEGIN
  543.           If (OldOffer < 1) Then BEGIN
  544.             REPEAT
  545.               GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  546.               temp1 := MatchToken(Ptrade.s[toks-1],'many.');
  547.               temp2 := MatchToken(Ptrade.s[toks-1],'credits.');
  548.             UNTIL ((NOT Loopit) or temp1 or temp2);
  549.           END;
  550.             if temp1 then begin
  551.               Loopit := FALSE;
  552.               Alarm;
  553.             end;
  554.             If (Loopit) then BEGIN {internal Loopit #1}
  555.               PortOffer := str_to_tw_int(Ptrade.s[4]);
  556.               If (BP5P < 1) then begin
  557.                 FO5P := PortOffer;
  558.                 OurOffer := PortOffer;
  559.                 DeltaH := 0.0;
  560.               end
  561.               else begin
  562.               If (OldOffer < 1) then begin
  563.                 Delta := PortOffer - FO5P;
  564.                 DeltaH := Delta/Hold[3];
  565.                 Delta := Hold[3]*round(DeltaH);
  566.                 OurOffer := BP5P + round(Delta);
  567.                 { ship out price }
  568.                 X := WhereX; Y := WhereY;
  569.                 SelectWindow(1);
  570.                 TextBackground(Green);
  571.                 ClrScr;
  572.                 Write(' Delta Holds = ',DeltaH:5:2,' Best price = ',OurOffer);
  573.                 NormalVideo;
  574.                 SelectWindow(2);
  575.                 GoToXY(X,Y);
  576.               end
  577.               else begin
  578.                 Delta := PortOffer - OldOffer;
  579.                 DeltaH := Delta/(Hold[3]*0.3);
  580.                 BP5P := BP5P + round(0.3*Delta);
  581.                 OurOffer := OldBid - trunc(2.333333333*Delta);
  582.                 If (Delta < 1) then begin
  583.                   Dec(OurOffer);
  584.                   OurOffer := 5*(OurOffer div 5);
  585.                 { we've missed the boat so maybe we start again }
  586.                 end;
  587.               end; { oldoffer }
  588.               END; { else BP5P < 1 }
  589.               { okay, Port asking for offer }
  590.               If Loopit then BEGIN
  591.                 Str(OurOffer,S);
  592.                 S := S + #13;
  593.                 Delay(500);
  594.                 Async_Send_String(S);
  595.                 { gak, hard part here }
  596.                 REPEAT
  597.                   GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  598.                   tempb1 := MatchToken(Ptrade.s[toks-1],'credits.');
  599.                   tempb2 := MatchToken(Ptrade.s[0],'<P-Probe');
  600.                   tempb3 := MatchToken(Ptrade.s[toks-2],'experience');
  601.                   tempb4 := MatchToken(Ptrade.s[3],'credits');
  602.                   tempb5 := MatchToken(Ptrade.s[toks-1],'interested.');
  603.                 UNTIL ((NOT Loopit) or tempb1 or tempb2 or
  604.                        tempb3 or tempb4 or tempb5);
  605.                 If tempb5 then begin
  606.                   Loopit := FALSE;
  607.                   Alarm;
  608.                 end;
  609.                 If tempb1 then BEGIN
  610.                   Done := FALSE;
  611.                   OldBid := OurOffer;
  612.                   OldOffer := PortOffer;
  613.                 END
  614.                 else Done := TRUE;
  615.                 If (Done and Loopit) then begin
  616.                   HasSold := TRUE;
  617.                   Inc(PCount);
  618.                   if tempb2 then begin
  619.                     ProbePct := pct_in_string(Ptrade);
  620.                     BP5P := round(OurOffer/ProbePct);
  621.                     FO5P := PortOffer;
  622.                   END;
  623.                   if tempb3 and (BP5P < 1) then begin
  624.                     BP5P := round(OurOffer/0.99);
  625.                     FO5P := PortOffer;
  626.                   END;
  627.                   if tempb4 and (BP5P < 1) then begin
  628.                     BP5P := round(OurOffer/0.97);
  629.                     FO5P := PortOffer;
  630.                   END;
  631.                 end; { Done }
  632.               END; { internal Loopit #2}
  633.             END; {internal Loopit #1}
  634.         END; {While NOT Done}
  635.       END; { else begin }
  636.       END; { If 'sell' }
  637.       UNTIL ((PCount >= MaxCount) or (NOT Loopit)); {port loop}
  638.  
  639. END;
  640.  
  641.  
  642.  
  643.  
  644. Procedure TradeAtAPort( PortBuy : string;
  645.                         Port4Sale : integer;
  646.                         var Buy,Sell : Real3;
  647.                         var Factor: Real3;
  648.                         Hold : Int3;
  649.                         MaxCount : integer;
  650.                         var Loopit : boolean);
  651.  
  652. { conducts a single trading round with a single port.  Uses portbuy
  653.   to determine how many products will be bought.  Can handle a case
  654.   where the ship has no products or when the ship has all the products
  655.   that are to be traded with this port.  Uses a second order correction
  656.   theory to alter both the buy and sell margins as well as the factor
  657.   used to alter bids in order to optimize both the first bid as well
  658.   as the rate at which agreement is reached when barter is involved.
  659.  
  660.   VARIABLES:
  661.  
  662.   INPUT:
  663.  
  664.   PortBuy - processed 3 character string of the 'XYS' variety.
  665.   Port4Sale - The number of products the port has for sale.
  666.   Buy - array of fractions to reduce port offer by.
  667.   Sell - array of fractions to increase port offer by.
  668.   Factor - array of linear factors to multiply differences by.
  669.   Hold - array of number of Holds of Fuel Ore, Org., and Eq. traded.
  670.   MaxCount - # of Haggles required for this port
  671.   Loopit - TRUE
  672.  
  673.   OUTPUT:
  674.  
  675.   Loopit - FALSE if ALT-Q pressed.
  676.  
  677.   LOCAL:
  678.  
  679.   TradeStr, InputStr, Ptrade, toks : GetALine vars.
  680.   HasSold - Boolean used to flag whether port has bought product.
  681.   PCount - # of Haggles so far.
  682.   PBuyCount - # of items for sale so far.
  683.   CurrentProduct - current product being traded.
  684.   OrigOffer - the first port offer
  685.   OldOffer - the previous port offer
  686.   PortOffer - the current port offer
  687.   PortOffer2 - a double check on the port offer.
  688.   OurOffer - our current offer.
  689.   OldBid - our first offer.
  690.   FirstOffer - A Boolean that flags whether this is the first price the
  691.                port offers.
  692.   SecondOffer - A Boolean that flags whether this is the second price the
  693.                 port offers.
  694.   f - a function defined by the equation:
  695.       BEST PRICE ESTIMATE - BEST PRICE = f*abs(PortOffer - OldOffer)
  696.       In a linear difference model then Factor is related to f
  697.       by the equation f = 1/(Factor + 1), and Factor = 1/f - 1.
  698.       We use f to calculate second order Buy/Sell and Factor corrections.
  699.   diff1, diff2 - positive differences between the first pair of
  700.                  port offers and the second pair of port offers.
  701.                  We use the ratio of diff2 over diff1 to determine
  702.                  real-time changes in f from our assumed original
  703.                  value of 0.3
  704.   Delta - positive difference between PortOffer and OldOffer.
  705.   Done - FALSE while macro and port haggling over price of product.
  706.   ProbePct - fraction of best price returned by Psychic Probe
  707.  
  708.   temp1 - true when port has insufficient product to sell.
  709.  
  710.   tempb1, tempb2, tempb3, tempb4 - used to alter prices..
  711.  
  712.   If tempb1 is true, the port has offered a new price and we
  713.   have to continue to barter.  The program then alters the
  714.   margins and bartering factors according to second order
  715.   overbidding theory.
  716.  
  717.   If tempb2 is true, then price has been decided and the Psychic
  718.   probe has returned a percent.  If this was the first offer, we adjust
  719.   our buy and sell margins accoringly.
  720.  
  721.   If tempb3 is true, then price has been decided and there was no
  722.   Psychic Probe used.  If we get just 1 experience and this was the
  723.   first offer, adjust buy and sell margins by 1%.
  724.  
  725.   If tempb4 is true, then price has been decided and there was no
  726.   Psychic Probe input.  Furthermore, our bid was so low that no
  727.   experience was earned, and our price is less than 98% of best.
  728.   We therefore adjust buy/sell margins by 3% if this was first bid.
  729.  
  730.   tempb5 - TRUE if buy/sell loop terminates because port is not interested.
  731. }
  732.  
  733. Label
  734.   StartOver, StartOver2;
  735. Var
  736.  
  737.   TradeStr, InputStr, S : string;
  738.   toks : integer;
  739.   PTrade : ParseType;
  740.   HasSold : boolean;
  741.   PCount, PBuyCount : integer;
  742.   CurrentProduct : integer;
  743.   OrigOffer,OldOffer,PortOffer,PortOffer2,OurOffer : integer;
  744.   OldBid : integer;
  745.   diff1, diff2 : integer;
  746.   FirstOffer,SecondOffer,Done : boolean;
  747.   temp1, temp2, tempb1, tempb2, tempb3, tempb4, tempb5 : boolean;
  748.   Delta : integer;
  749.   ProbePct,f,OldFactor : real;
  750.   XCol, XBak : integer;
  751.   X,Y : integer;
  752.  
  753. BEGIN
  754.       Tradestr := ' '+#9+#10+#13;
  755.       Delay(1000);
  756.       Async_Send('P');
  757.       REPEAT
  758.         GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  759.       UNTIL ((NOT Loopit) or MatchToken(Ptrade.s[toks-1],'?'));
  760.       Delay(500);
  761.       Async_Send('T');
  762.       HasSold := FALSE;
  763.       PCount := 0;
  764.       PBuyCount := 0;
  765.       REPEAT { Have You exhausted this port? }
  766.       REPEAT
  767.         GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  768.       UNTIL ((NOT Loopit) or MatchToken(Ptrade.s[toks-2],'sell') or
  769.               MatchToken(Ptrade.s[toks-2],'buy'));
  770.       If ((NOT HasSold) and MatchToken(Ptrade.s[toks-2],'buy') and
  771.       (Port4Sale < MaxCount)) THEN
  772.         MaxCount := Port4Sale; { take care of empty holds situation }
  773.       If (MatchToken(Ptrade.s[toks-2],'buy') and Loopit) THEN BEGIN
  774.         Currentproduct := Product_Num(Ptrade.s[4]);
  775.         IF (PortBuy[Currentproduct] <> 'S') THEN BEGIN
  776.           S := '0'+#13;
  777.           Async_Send_String(S);
  778.           Inc(PCount);
  779.           Inc(PBuyCount);
  780.         END
  781.         ELSE BEGIN
  782.         Str(Hold[CurrentProduct],S);
  783.         S := S + #13;
  784.         Async_Send_String(S);
  785.         OldOffer := 0;
  786.         FirstOffer := TRUE;
  787.         SecondOffer := FALSE;
  788.         Done := FALSE;
  789.         X := WhereX; Y := WhereY;
  790.         SelectWindow(1);
  791.         XCol := TextAttr and 15;
  792.         XBak := (TextAttr shr 4) and 7;
  793.         TextColor(Blue);
  794.         TextBackground(LightCyan);
  795.         ClrScr;
  796.         Write(' Buy[',StrProd[CurrentProduct],'] = ',Buy[CurrentProduct]:6:3,
  797.               ' ■■ Factor[',StrProd[CurrentProduct],'] = ',
  798.               Factor[CurrentProduct]:7:4);
  799.         TextColor(XCol);
  800.         TextBackground(XBak);
  801.         SelectWindow(2);
  802.         GoToXY(X,Y);
  803.         { add a loop here }
  804.         While ((NOT Done) and Loopit) do BEGIN
  805.           If FirstOffer Then BEGIN
  806.             REPEAT
  807.               GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  808.               temp1 := MatchToken(Ptrade.s[toks-1],'many.');
  809.               temp2 := MatchToken(Ptrade.s[toks-1],'credits.');
  810.             UNTIL ((NOT Loopit) or temp1 or temp2);
  811.           END;
  812.             if temp1 then begin
  813.               Loopit := FALSE;
  814.               Alarm;
  815.             end;
  816.             If (Loopit) then BEGIN {internal Loopit #1}
  817.               PortOffer2 := 0;
  818.               PortOffer := str_to_tw_int(Ptrade.s[4]);
  819. StartOver:
  820.               If (OldOffer > 0) THEN BEGIN
  821.                 Delta := Abs(PortOffer - OldOffer);
  822.                 OurOffer := OurOffer + round(Factor[CurrentProduct]*Delta);
  823.                 If (Delta < 1) then
  824.                   Inc(OurOffer);
  825.                 If MatchToken(Ptrade.s[1],'final') THEN
  826.                   Inc(OurOffer);
  827.                 OldOffer := PortOffer;
  828.               END
  829.               ELSE BEGIN
  830.                 OldOffer := PortOffer;
  831.                 OurOffer := round(PortOffer*Buy[CurrentProduct]);
  832.               END;
  833.               If (PortOffer2 < 1) then begin
  834.                 REPEAT
  835.                   GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  836.                 UNTIL ((NOT Loopit) or MatchToken(Ptrade.s[toks-1],'?'));
  837.                 PortOffer2 := str_to_tw_int(Ptrade.s[toks-2]);
  838.                 { double check that price }
  839.                   If (PortOffer2 > 2*PortOffer) then begin
  840.                     PortOffer := PortOffer2;
  841.                     goto StartOver;
  842.                   end;
  843.               end;
  844.               { okay, Port asking for offer }
  845.               If (Loopit) then BEGIN
  846.                 Str(OurOffer,S);
  847.                 S := S + #13;
  848.                 Async_Send_String(S);
  849.                 Delay(1000);
  850.                 { gak, hard part here }
  851.                 REPEAT
  852.                   GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  853.                   tempb1 := MatchToken(Ptrade.s[toks-1],'credits.');
  854.                   tempb2 := MatchToken(Ptrade.s[0],'<P-Probe');
  855.                   tempb3 := MatchToken(Ptrade.s[toks-2],'experience');
  856.                   tempb4 := MatchToken(Ptrade.s[3],'credits');
  857.                   tempb5 := MatchToken(Ptrade.s[toks-1],'interested.');
  858.                 UNTIL ((NOT Loopit) or tempb1 or tempb2 or
  859.                        tempb3 or tempb4 or tempb5);
  860.                 If tempb5 then begin
  861.                   Loopit := FALSE;
  862.                   Alarm;
  863.                 end;
  864.                 If tempb1 then BEGIN
  865.                   Done := FALSE;
  866.                   PortOffer := str_to_tw_int(Ptrade.s[4]);
  867.                   if SecondOffer = TRUE then begin
  868.                     SecondOffer := FALSE;
  869.                     { second order margin and factor corrections}
  870.                     diff1 := abs(OldOffer - OrigOffer);
  871.                     diff2 := abs(PortOffer - OldOffer);
  872.                     if (diff1 >= DeltaFactorOffer) then begin
  873.                       f := 1.0/(Factor[CurrentProduct] + 1.0);
  874.                       f := f - diff2/diff1;
  875.                       Factor[CurrentProduct] := 1.0/f - 1.0;
  876.                       Buy[CurrentProduct] := (OldBid + diff1/f)/
  877.                                              (OrigOffer);
  878.                     end;
  879.                   end;
  880.                   if FirstOffer = TRUE then begin
  881.                     FirstOffer := FALSE;
  882.                     SecondOffer := TRUE;
  883.                     OrigOffer := OldOffer;
  884.                     OldBid := OurOffer;
  885.                     { make a first order margin correction }
  886.                     diff1 := abs(PortOffer - OldOffer);
  887.                     f := 1.0/(Factor[CurrentProduct] + 1.0);
  888.                     Buy[CurrentProduct] := (OldBid + diff1/f)/
  889.                                            (OrigOffer);
  890.                   end;
  891.                   FirstOffer := FALSE;
  892.                 END
  893.                 else Done := TRUE;
  894.                 If (Done and Loopit) then begin
  895.                   Inc(PCount);
  896.                   Inc(PBuyCount);
  897.                   if tempb2 and FirstOffer then begin
  898.                     ProbePct := pct_in_string(Ptrade);
  899.                     Buy[CurrentProduct] := Buy[CurrentProduct]*ProbePct;
  900.                   END; { if tempb2}
  901.                   if tempb2 and SecondOffer then begin
  902.                     ProbePct := pct_in_string(Ptrade);
  903.                     diff2 := abs(OldOffer - OrigOffer);
  904.                     OldFactor := Factor[CurrentProduct];
  905.                     if (diff2 > DeltaFactorPsp) then begin
  906.                       Factor[CurrentProduct] := abs(OurOffer*ProbePct - OldBid)/diff2;
  907.                     end;
  908.                   END; { if tempb2}
  909.                   if tempb3 and FirstOffer then begin
  910.                     If MatchToken(Ptrade.s[toks-3],'1') then
  911.                       Buy[CurrentProduct] := Buy[CurrentProduct] - 0.01;
  912.                   END;
  913.                   if tempb3 and SecondOffer then begin
  914.                     diff2 := abs(OldOffer - OrigOffer);
  915.                     if (diff2 > DeltaFactorPsp) then
  916.                       Factor[CurrentProduct] := abs(OurOffer*0.99 - OldBid)/diff2;
  917.                   END; { if tempb2}
  918.                   if tempb4 and FirstOffer then begin
  919.                     Buy[CurrentProduct] := Buy[CurrentProduct] - 0.03;
  920.                   END;
  921.                   if tempb4 and SecondOffer then begin
  922.                     diff2 := abs(OldOffer - OrigOffer);
  923.                     if (diff2 > DeltaFactorPsp) then
  924.                       Factor[CurrentProduct] := abs(OurOffer*0.98 - OldBid)/diff2;
  925.                   END; { if tempb2}
  926.                 end; { Done }
  927.               END; { internal Loopit #2}
  928.             END; {internal Loopit #1}
  929.         END; {While NOT Done}
  930.         END; {else if PortBuy.. }
  931.       END; { If 'buy' }
  932.  
  933.       If (MatchToken(Ptrade.s[toks-2],'sell') and Loopit) THEN BEGIN
  934.         Currentproduct := Product_Num(Ptrade.s[4]);
  935.         IF (PortBuy[Currentproduct] <> 'B') THEN BEGIN
  936.           { lack of this 5 line piece of code in versions 0.92 and below
  937.             caused problems with trades between classes 2, 4 and 6}
  938.           S := '0'+#13;
  939.           Async_Send_String(S);
  940.           { Inc(PCount); Removing this to allow 0 porting with or
  941.             without product "onboard".  This should help when someone
  942.             is trading with megaholds and needs an organic or fuel ore
  943.             to lock the holds in. }
  944.         END
  945.         ELSE BEGIN
  946.         S := '';
  947.         S := #13;
  948.         Async_Send_String(S);
  949.         OldOffer := 0;
  950.         FirstOffer := TRUE;
  951.         SecondOffer := FALSE;
  952.         Done := FALSE;
  953.         X := WhereX; Y := WhereY;
  954.         SelectWindow(1);
  955.         XCol := TextAttr and 15;
  956.         XBak := (TextAttr shr 4) and 7;
  957.         TextColor(White);
  958.         TextBackground(Green);
  959.         ClrScr;
  960.         Write(' Sell[',StrProd[CurrentProduct],'] = ',Sell[CurrentProduct]:6:3,
  961.               ' ■■ Factor[',StrProd[CurrentProduct],'] = ',Factor[CurrentProduct]:7:4);
  962.         TextColor(XCol);
  963.         TextBackground(XBak);
  964.         SelectWindow(2);
  965.         GoToXY(X,Y);
  966.         TextColor(XCol);
  967.         { add a loop here }
  968.         While ((NOT Done) and Loopit) do BEGIN
  969.           If FirstOffer Then BEGIN
  970.             REPEAT
  971.               GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  972.             UNTIL ((NOT Loopit) or MatchToken(Ptrade.s[toks-1],'credits.'));
  973.           END;
  974.             If (Loopit) then BEGIN {internal Loopit #1}
  975.               PortOffer2 := 0;
  976.               PortOffer := str_to_tw_int(Ptrade.s[4]);
  977. StartOver2:
  978.               If (OldOffer > 0) THEN BEGIN
  979.                 Delta := Abs(PortOffer - OldOffer);
  980.                 OurOffer := OurOffer - round(Factor[CurrentProduct]*Delta);
  981.                 If (Delta < 1) then
  982.                   Dec(OurOffer);
  983.                 If MatchToken(Ptrade.s[1],'final') then
  984.                   Dec(OurOffer);
  985.                 OldOffer := PortOffer;
  986.               END
  987.               ELSE BEGIN
  988.                 OldOffer := PortOffer;
  989.                 OurOffer := round(PortOffer*Sell[CurrentProduct]);
  990.               END;
  991.               If (PortOffer2 < 1) then begin
  992.                 REPEAT
  993.                   GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  994.                 UNTIL ((NOT Loopit) or MatchToken(Ptrade.s[toks-1],'?'));
  995.                 PortOffer2 := str_to_tw_int(Ptrade.s[toks-2]);
  996.                 { double check that price }
  997.                   If (PortOffer2 > 2*PortOffer) then begin
  998.                     PortOffer := PortOffer2;
  999.                     goto StartOver2;
  1000.                   end;
  1001.               end;
  1002.               { okay, Port asking for offer }
  1003.               If Loopit then BEGIN
  1004.                 Str(OurOffer,S);
  1005.                 S := S + #13;
  1006.                 Async_Send_String(S);
  1007.                 Delay(1000);
  1008.                 { gak, hard part here }
  1009.                 REPEAT
  1010.                   GetALine(toks,tradestr,inputstr,'?',Ptrade,Loopit);
  1011.                   tempb1 := MatchToken(Ptrade.s[toks-1],'credits.');
  1012.                   tempb2 := MatchToken(Ptrade.s[0],'<P-Probe');
  1013.                   tempb3 := MatchToken(Ptrade.s[toks-2],'experience');
  1014.                   tempb4 := MatchToken(Ptrade.s[3],'credits');
  1015.                   tempb5 := MatchToken(Ptrade.s[toks-1],'interested.');
  1016.                 UNTIL ((NOT Loopit) or tempb1 or tempb2 or
  1017.                        tempb3 or tempb4 or tempb5);
  1018.                 If tempb5 then begin
  1019.                   Loopit := FALSE;
  1020.                   Alarm;
  1021.                 end;
  1022.                 If tempb1 then BEGIN
  1023.                   Done := FALSE;
  1024.                   PortOffer := str_to_tw_int(Ptrade.s[4]);
  1025.                   if SecondOffer = TRUE then begin
  1026.                   { Second order correction assuming Linear
  1027.                     Difference model of port trading }
  1028.                     SecondOffer := FALSE;
  1029.                     diff1 := abs(OldOffer - OrigOffer);
  1030.                     diff2 := abs(PortOffer - OldOffer);
  1031.                     If (diff1 > DeltaFactorOffer) then begin
  1032.                       f := 1.0/(Factor[CurrentProduct] + 1.0);
  1033.                       f := f - diff2/diff1;
  1034.                       Factor[CurrentProduct] := 1.0/f - 1.0;
  1035.                       Sell[CurrentProduct] := (OldBid - diff1/f)/
  1036.                                               (OrigOffer);
  1037.                     end;
  1038.                   end;
  1039.                   if FirstOffer = TRUE then begin
  1040.                     FirstOffer := FALSE;
  1041.                     SecondOffer := TRUE;
  1042.                     OrigOffer := OldOffer;
  1043.                     OldBid := OurOffer;
  1044.                     { make a first order margin correction }
  1045.                     diff1 := abs(PortOffer - OldOffer);
  1046.                     f := 1.0/(Factor[CurrentProduct] + 1.0);
  1047.                     Sell[CurrentProduct] := (OldBid - diff1/f)/
  1048.                                             (OrigOffer);
  1049.                   end;
  1050.                 END
  1051.                 else Done := TRUE;
  1052.                 If (Done and Loopit) then begin
  1053.                   HasSold := TRUE;
  1054.                   Inc(PCount);
  1055.                   if tempb2 and FirstOffer then begin
  1056.                     ProbePct := pct_in_string(Ptrade);
  1057.                     Sell[CurrentProduct] := Sell[CurrentProduct]/ProbePct;
  1058.                   END;
  1059.                   if tempb2 and SecondOffer then begin
  1060.                     ProbePct := pct_in_string(Ptrade);
  1061.                     diff2 := abs(OldOffer - OrigOffer);
  1062.                     OldFactor := Factor[CurrentProduct];
  1063.                     if (diff2 > DeltaFactorPsp) then begin
  1064.                       Factor[CurrentProduct] := (OldBid - OurOffer/ProbePct)/diff2;
  1065.                     end;
  1066.                   END; { if tempb2}
  1067.                   if tempb3 and FirstOffer then begin
  1068.                     If MatchToken(Ptrade.s[toks-3],'1') then
  1069.                       Sell[CurrentProduct] := Sell[CurrentProduct] + 0.01;
  1070.                   END;
  1071.                   if tempb3 and SecondOffer then begin
  1072.                     diff2 := abs(OldOffer - OrigOffer);
  1073.                     if (diff2 > DeltaFactorPsp) then
  1074.                       Factor[CurrentProduct] := (OldBid - OurOffer/0.99)/diff2;
  1075.                   END; { if tempb3}
  1076.                   if tempb4 and FirstOffer then begin
  1077.                     Sell[CurrentProduct] := Sell[CurrentProduct] + 0.03;
  1078.                   END;
  1079.                   if tempb4 and SecondOffer then begin
  1080.                     diff2 := abs(OldOffer - OrigOffer);
  1081.                     if (diff2 > DeltaFactorPsp) then
  1082.                       Factor[CurrentProduct] := (OldBid - OurOffer/0.98)/diff2;
  1083.                   END; { if tempb4}
  1084.                 end; { Done }
  1085.               END; { internal Loopit #2}
  1086.             END; {internal Loopit #1}
  1087.         END; {While NOT Done}
  1088.       END; { else begin }
  1089.       END; { If 'sell' }
  1090.       UNTIL ((PCount >= MaxCount) or (NOT Loopit)); {port loop}
  1091.  
  1092. END;
  1093.  
  1094. Procedure MoveToANewPort(var Port : string; var Loop : boolean);
  1095. { this algorithm is sometimes buggy
  1096.   4-24-93 - killed bug. Loop was neither passed nor initialized.}
  1097. Var
  1098.   toks,i : integer;
  1099.   tstr,istr,S : string;
  1100.   P : parsetype;
  1101.   temp1, temp2 : boolean;
  1102.   X, Y : integer;
  1103.  
  1104. BEGIN
  1105.   { clear out remnants of last trade }
  1106.   Loop := TRUE;
  1107.   Tstr := ' '+#9+#10+#13;
  1108.   X := WhereX; Y := WhereY;
  1109.   TextColor(White);
  1110.   TextBackground(Cyan);
  1111.   SelectWindow(1);
  1112.   ClrScr;
  1113.   Write('      === ALT T- Tradewars Paired Port Trading. ALT Q Quits. ===      ');
  1114.   NormalVideo;
  1115.   SelectWindow(2);
  1116.   GoToXY(X,Y);
  1117.   REPEAT
  1118.     GetALine(toks,tstr,istr,'?',P,Loop);
  1119.     temp1 := MatchToken(P.s[toks-2],'buy');
  1120.     If temp1 then begin
  1121.     { if Equipment zeroed then it is possible for trade loop to terminate
  1122.       prematurely, so we clear out those trades here }
  1123.       S := '0'+#13;
  1124.       Async_Send_String(S);
  1125.     end;
  1126.   UNTIL ((NOT Loop) or MatchToken(P.s[toks-1],'=Help)?'));
  1127.   Delay(1000); { keep this delay *AFTER* the REPEAT loop! }
  1128.     If Loop then begin
  1129.       If (length(Port) < 3) or ((length(Port) = 3) and (Port[1] = '1')) THEN
  1130.       { In TW beta 2.0, I wonder how these port numbers will be handled? }
  1131.         S := Port+#13
  1132.       ELSE S := Port;
  1133.       Async_Send_String(S);
  1134.       REPEAT
  1135.         GetALine(toks,tstr,istr,'?',P,Loop);
  1136.         temp2 := MatchToken(P.s[toks-1],'=Help)?');
  1137.       UNTIL ((NOT Loop) or temp2);
  1138.     end;
  1139. END;
  1140.  
  1141.  
  1142. Procedure Trade;
  1143. Label
  1144.   NoTrade;
  1145.  
  1146. Var
  1147.   Port1, Port2, Port1Buy, Port2Buy, tokstr : String;
  1148.   P1b, P1s : real3;
  1149.   P2b, P2s : real3;
  1150.   P1F, P2F : Real3;
  1151.   NTraded, MaxNBought : integer;
  1152.   P1_4Sale,P2_4Sale : integer;
  1153.   P1Haggle, P2Haggle : Integer;
  1154.   P1Buy, P2Buy : integer;
  1155.   TotHolds,SumHolds : integer;
  1156.   Holds : Int3;
  1157.   Loop : Boolean;
  1158.   X,Y,i,toks : integer;
  1159.   P : parsetype;
  1160.  
  1161. BEGIN
  1162.   tokstr := ' ,:;'+#8+#9+#10+#13;
  1163.   SaveScreen(X,Y);
  1164.   Window(5,5,40,15);
  1165.   YellowVideo;
  1166.   ClrScr;
  1167.   Loop := TRUE;
  1168.   for i := 1 to 3 do begin
  1169.     P1F[i] := DefaultFactor;
  1170.     P2F[i] := DefaultFactor;
  1171.     P1B[i] := DefaultBuy;
  1172.     P1S[i] := DefaultSell;
  1173.     P2B[i] := DefaultBuy;
  1174.     P2S[i] := DefaultSell;
  1175.   end;
  1176.   Write('           Port 1: ');
  1177.   ReadLn(Port1);
  1178.   { tokenize the string and take the first token to kill any leading
  1179.     blanks or tabs }
  1180.   toks := Parse_Str(tokstr,Port1,P);
  1181.   If toks > 0 then
  1182.     Port1 := P.s[0];
  1183.   Write('      Port 1 Type: ');
  1184.   ReadLn(Port1Buy);
  1185.   toks := Parse_Str(tokstr,Port1Buy,P);
  1186.   If toks > 0 then
  1187.     Port1Buy := P.s[0];
  1188.  
  1189.   { if somebody enters a port class, convert it to the 3 char string }
  1190.   If ((length(Port1Buy) = 1) and (isdigit(Port1Buy[1]))) then
  1191.     Port1Buy := ClassStr[Ord(Port1Buy[1]) - Ord('0')];
  1192.   Write('           Port 2: ');
  1193.   ReadLn(Port2);
  1194.   toks := Parse_Str(tokstr,Port2,P);
  1195.   If toks > 0 then
  1196.     Port2 := P.s[0];
  1197.   Write('      Port 2 Type: ');
  1198.   ReadLn(Port2Buy);
  1199.   toks := Parse_Str(tokstr,Port2Buy,P);
  1200.   If toks > 0 then
  1201.     Port2Buy := P.s[0];
  1202.   { if somebody enters a port class, convert it to the 3 char string }
  1203.   If ((length(Port2Buy) = 1) and (isdigit(Port2Buy[1]))) then
  1204.     Port2Buy := ClassStr[Ord(Port2Buy[1]) - Ord('0')];
  1205.  
  1206.   { Find out how many products we can trade and other tedious goodies }
  1207.  
  1208.   Process_Port_Pair(Port1Buy,Port2Buy,NTraded,P1Buy,P2Buy,
  1209.                     P1Haggle,P2Haggle,P1_4Sale,P2_4Sale);
  1210.  
  1211.   { if we have products to trade, then trade }
  1212.   If (NTraded > 0) THEN
  1213.     BEGIN
  1214.       WriteLn(' Num. Products Traded = ',NTraded);
  1215.       Write(' How many Holds to Trade with : ');
  1216.       ReadLn(TotHolds);
  1217.       For i := 1 to 3 do begin
  1218.         Holds[i] := -1;
  1219.         If (Port1Buy[i] <> 'X') and (Port1Buy[i] <> 'Y') then begin
  1220.           Write(' How Many Holds For ',StrProd[i],': ');
  1221.           ReadLn(Holds[i]);
  1222.           { check for zero valued holds.  If Holds = 0, then
  1223.             user must not want to trade the product }
  1224.           If (Holds[i] = 0) then begin
  1225.             If Port1Buy[i] = 'S' then begin
  1226.               Port1Buy[i] := 'Y';
  1227.               Dec(P1Buy);
  1228.               { don't give product any holds if we aren't trading it }
  1229.             end;
  1230.             If Port1Buy[i] = 'B' then begin
  1231.               Port1Buy[i] := 'X';
  1232.               Dec(P1Haggle);
  1233.               { Can't Haggle for it if it isn't onboard }
  1234.             end;
  1235.             If Port2Buy[i] = 'S' then begin
  1236.               Port2Buy[i] := 'Y';
  1237.               Dec(P2Buy);
  1238.               { don't give product any holds if we aren't trading it }
  1239.             end;
  1240.             If Port2Buy[i] = 'B' then begin
  1241.               Port2Buy[i] := 'X';
  1242.               Dec(P2Haggle);
  1243.               { Can't haggle for it if it isn't onboard }
  1244.             end;
  1245.           end;
  1246.         end;
  1247.       end;
  1248.  
  1249.       { trap any weirdness before we divide by P1Buy or P2Buy }
  1250.       If (P1Buy < 1) then
  1251.         P1Buy := 1;
  1252.       If (P2Buy < 1) then
  1253.         P2Buy := 1;
  1254.  
  1255.       {
  1256.         idiot proof input. Set it up so that entering a number of
  1257.         holds = -1 equally divides holds between products.  Note
  1258.         algorithm works best when holds evenly divisible by 6.
  1259.         TWFT 0.94 and up:
  1260.         Note algorithm has been reworked so that any mixture of
  1261.         -1s, 0s, and positive hold numbers can be mixed.  If the
  1262.         sum of the number of holds is less than the number of
  1263.         total holds you enter, we assume the user knows what
  1264.         he is doing and do nothing.  If the number is greater
  1265.         than the total number of holds, we recalculate so that
  1266.         the trade can be completed.
  1267.       }
  1268.       SumHolds := 0;
  1269.       for i := 1 to 3 do
  1270.         If (Port1Buy[i] = 'S') then begin
  1271.           if (Holds[i] < 0) then
  1272.             Holds[i] := TotHolds div P1Buy;
  1273.           SumHolds := SumHolds + Holds[i];
  1274.         end;
  1275.       { split if user assigned all holds = 0 }
  1276.       If (SumHolds = 0) then
  1277.         Goto NoTrade;
  1278.       If (SumHolds > TotHolds) then
  1279.         for i := 1 to 3 do
  1280.           If (Port1Buy[i] = 'S') then
  1281.             Holds[i] := TotHolds div P1Buy;
  1282.       SumHolds := 0;
  1283.       for i := 1 to 3 do
  1284.         If (Port2Buy[i] = 'S') then begin
  1285.           if (Holds[i] < 0) then
  1286.             Holds[i] := TotHolds div P2Buy;
  1287.           SumHolds := SumHolds + Holds[i];
  1288.         end;
  1289.       If (SumHolds > TotHolds) then
  1290.         for i := 1 to 3 do
  1291.           If (Port2Buy[i] = 'S') then
  1292.             Holds[i] := TotHolds div P2Buy;
  1293.       NormalVideo;
  1294.       SelectWindow(2);
  1295.       RestoreScreen;
  1296.       GoToXY(X,Y);
  1297.       { notify user Trading Macro is active }
  1298.       TextColor(White);
  1299.       TextBackground(Cyan);
  1300.       SelectWindow(1);
  1301.       ClrScr;
  1302.       Write('      === ALT T- Tradewars Paired Port Trading. ALT Q Quits. ===      ');
  1303.       NormalVideo;
  1304.       SelectWindow(2);
  1305.       GoToXY(X,Y);
  1306.  
  1307.       { trading loop }
  1308.  
  1309.       REPEAT
  1310.       { Trade until a user types ALT-Q or routine hits exit condition}
  1311.       TradeAtAPort(Port1Buy,P1_4Sale,P1B,P1S,P1F,Holds,P1Haggle,Loop);
  1312.       If Loop then
  1313.         MoveToANewPort(Port2,Loop);
  1314.       If Loop then
  1315.       TradeAtAPort(Port2Buy,P2_4Sale,P2B,P2S,P2F,Holds,P2Haggle,Loop);
  1316.       If Loop then
  1317.         MoveToANewPort(Port1,Loop);
  1318.       UNTIL NOT Loop;
  1319.       SaveScreen(X,Y);
  1320.       TextColor(Yellow);
  1321.       TextBackground(Blue);
  1322.       GoToXY(10,10);WriteLn('                     ');
  1323.       GoToXY(10,11);WriteLn(' Exiting TRADE Macro ');
  1324.       GoToXY(10,12);WriteLn('                     ');
  1325.       Delay(3000);
  1326.       NormalVideo;
  1327.       RestoreScreen;
  1328.       GotoXY(X,Y);
  1329.  
  1330.     END { if NTraded > 0 }
  1331.   ELSE BEGIN
  1332.  
  1333. NoTrade:
  1334.     { no products to trade, so split }
  1335.  
  1336.     SelectWindow(2);
  1337.     RestoreScreen;
  1338.     GoToXY(X,Y);
  1339.     SaveScreen(X,Y);
  1340.     TextColor(White);
  1341.     TextBackground(Red);
  1342.     GoToXY(10,10);WriteLn('                                                ');
  1343.     GoToXY(10,11);WriteLn(' No products are traded between these two ports ');
  1344.     GoToXY(10,12);WriteLn('                                                ');
  1345.     Delay(3000);
  1346.     NormalVideo;
  1347.     RestoreScreen;
  1348.     GoToXY(X,Y);
  1349.   END;
  1350. END;
  1351.  
  1352.  
  1353. Procedure Steal;
  1354.  
  1355. Var
  1356.   Port1Buy, Port2Buy : String;
  1357.   P1b, P1s : real3;
  1358.   P1F : Real3;
  1359.   NTraded, MaxNBought : integer;
  1360.   P1_4Sale,P2_4Sale : integer;
  1361.   P1Haggle, P2Haggle : Integer;
  1362.   P1Buy, P2Buy : integer;
  1363.   TotHolds,SumHolds : integer;
  1364.   Holds : Int3;
  1365.   Loop : Boolean;
  1366.   HasSold : Boolean;
  1367.   X,Y,i : integer;
  1368.  
  1369. BEGIN
  1370.   SaveScreen(X,Y);
  1371.   Window(5,5,40,15);
  1372.   YellowVideo;
  1373.   ClrScr;
  1374.   Loop := TRUE;
  1375.   for i := 1 to 3 do begin
  1376.     P1F[i] := DefaultFactor;
  1377.     P1B[i] := DefaultBuy;
  1378.     P1S[i] := DefaultSell;
  1379.   end;
  1380.   Write('        Port Type: ');
  1381.   ReadLn(Port1Buy);
  1382.   { if somebody enters a port class, convert it to the 3 char string }
  1383.   If ((length(Port1Buy) = 1) and (isdigit(Port1Buy[1]))) then
  1384.     Port1Buy := ClassStr[Ord(Port1Buy[1]) - Ord('0')];
  1385.   Port2Buy := Port1Buy;
  1386.   Port2Buy[3] := 'S';
  1387.   { Finding out how many products we can "trade" }
  1388.  
  1389.   Process_Port_Pair(Port1Buy,Port2Buy,NTraded,P1Buy,P2Buy,
  1390.                     P1Haggle,P2Haggle,P1_4Sale,P2_4Sale);
  1391.  
  1392.   { if we can sell equipment to this port, then steal }
  1393.   If (NTraded > 0) THEN
  1394.     BEGIN
  1395.       Write(' How many Holds to Trade with : ');
  1396.       ReadLn(TotHolds);
  1397.       For i := 1 to 3 do begin
  1398.         If i = 3 then
  1399.           Holds[i] := TotHolds
  1400.         else Holds[i] := 0;
  1401.       end;
  1402.       NormalVideo;
  1403.       SelectWindow(2);
  1404.       RestoreScreen;
  1405.       GoToXY(X,Y);
  1406.       { notify user Stealing Macro is active }
  1407.       TextColor(White);
  1408.       TextBackground(Cyan);
  1409.       SelectWindow(1);
  1410.       ClrScr;
  1411.       Write('      === ALT S- Tradewars Steal/Sell. ALT Q Quits. ===      ');
  1412.       NormalVideo;
  1413.       SelectWindow(2);
  1414.       GoToXY(X,Y);
  1415.  
  1416.       { stealing loop }
  1417.       HasSold := FALSE;
  1418.       REPEAT
  1419.       { Trade until a user types ALT-Q or routine hits exit condition}
  1420.       StealAtAPort(Loop,HasSold,Holds[3],STwo);
  1421.       If Loop then begin
  1422.         TradeAtAPort(Port1Buy,P1_4Sale,P1B,P1S,P1F,Holds,P1Haggle,Loop);
  1423.         HasSold := TRUE;
  1424.       end;
  1425.       UNTIL NOT Loop;
  1426.       SaveScreen(X,Y);
  1427.       TextColor(Yellow);
  1428.       TextBackground(Blue);
  1429.       GoToXY(10,10);WriteLn('                     ');
  1430.       GoToXY(10,11);WriteLn(' Exiting STEAL Macro ');
  1431.       GoToXY(10,12);WriteLn('                     ');
  1432.       Delay(3000);
  1433.       NormalVideo;
  1434.       RestoreScreen;
  1435.       GotoXY(X,Y);
  1436.  
  1437.     END { if NTraded > 0 }
  1438.   ELSE BEGIN
  1439.  
  1440.     { no Equipment to sell, so split }
  1441.  
  1442.     SelectWindow(2);
  1443.     RestoreScreen;
  1444.     GoToXY(X,Y);
  1445.     SaveScreen(X,Y);
  1446.     TextColor(White);
  1447.     TextBackground(Red);
  1448.     GoToXY(10,10);WriteLn('                                      ');
  1449.     GoToXY(10,11);WriteLn(' Equipment is not bought at this port ');
  1450.     GoToXY(10,12);WriteLn('                                      ');
  1451.     Delay(3000);
  1452.     NormalVideo;
  1453.     RestoreScreen;
  1454.     GoToXY(X,Y);
  1455.   END;
  1456. END;
  1457.  
  1458. Procedure FivePointSteal;
  1459.  
  1460. Var
  1461.   Port1Buy, Port2Buy : String;
  1462.   P1b, P1s : real3;
  1463.   P1F : Real3;
  1464.   NTraded, MaxNBought : integer;
  1465.   P1_4Sale,P2_4Sale : integer;
  1466.   P1Haggle, P2Haggle : Integer;
  1467.   P1Buy, P2Buy : integer;
  1468.   TotHolds,SumHolds : integer;
  1469.   Bp5p , Fo5p : integer;
  1470.   Holds : Int3;
  1471.   Loop : Boolean;
  1472.   HasSold : Boolean;
  1473.   X,Y,i : integer;
  1474.  
  1475. BEGIN
  1476.   SaveScreen(X,Y);
  1477.   Window(5,5,40,15);
  1478.   YellowVideo;
  1479.   ClrScr;
  1480.   Loop := TRUE;
  1481.   for i := 1 to 3 do begin
  1482.     { none of these are used but it keeps process_port_pair happy }
  1483.     P1F[i] := DefaultFactor;
  1484.     P1B[i] := DefaultBuy;
  1485.     P1S[i] := DefaultSell;
  1486.   end;
  1487.   WriteLn('  5 Pt Steal/Sell:');
  1488.   Write('        Port Type: ');
  1489.   ReadLn(Port1Buy);
  1490.   { if somebody enters a port class, convert it to the 3 char string }
  1491.   If ((length(Port1Buy) = 1) and (isdigit(Port1Buy[1]))) then
  1492.     Port1Buy := ClassStr[Ord(Port1Buy[1]) - Ord('0')];
  1493.   Port2Buy := Port1Buy;
  1494.   Port2Buy[3] := 'S';
  1495.   { Finding out how many products we can "trade" }
  1496.  
  1497.   Process_Port_Pair(Port1Buy,Port2Buy,NTraded,P1Buy,P2Buy,
  1498.                     P1Haggle,P2Haggle,P1_4Sale,P2_4Sale);
  1499.  
  1500.   { if we can sell equipment to this port, then steal }
  1501.   If (NTraded > 0) THEN
  1502.     BEGIN
  1503.       Write(' How many Holds to Trade with : ');
  1504.       ReadLn(TotHolds);
  1505.       For i := 1 to 3 do begin
  1506.         If i = 3 then
  1507.           Holds[i] := TotHolds
  1508.         else Holds[i] := 0;
  1509.       end;
  1510.       NormalVideo;
  1511.       SelectWindow(2);
  1512.       RestoreScreen;
  1513.       GoToXY(X,Y);
  1514.       { notify user Stealing Macro is active }
  1515.       TextColor(White);
  1516.       TextBackground(Cyan);
  1517.       SelectWindow(1);
  1518.       ClrScr;
  1519.       Write('      === ALT 5- 5 Point Steal/Sell. ALT Q Quits. ===      ');
  1520.       NormalVideo;
  1521.       SelectWindow(2);
  1522.       GoToXY(X,Y);
  1523.  
  1524.       { stealing loop }
  1525.       BP5P := 0;
  1526.       FO5P := 0;
  1527.       HasSold := FALSE;
  1528.       REPEAT
  1529.       { Trade until a user types ALT-Q or routine hits exit condition}
  1530.       StealAtAPort(Loop,HasSold,Holds[3],SFive);
  1531.       If Loop then begin
  1532.         FivePointTrade(Port1Buy,P1_4Sale,BP5P,Fo5p,Holds,P1Haggle,Loop);
  1533.         HasSold := TRUE;
  1534.       end;
  1535.       UNTIL NOT Loop;
  1536.       SaveScreen(X,Y);
  1537.       TextColor(Yellow);
  1538.       TextBackground(Blue);
  1539.       GoToXY(10,10);WriteLn('                     ');
  1540.       GoToXY(10,11);WriteLn(' Exiting STEAL Macro ');
  1541.       GoToXY(10,12);WriteLn('                     ');
  1542.       Delay(3000);
  1543.       NormalVideo;
  1544.       RestoreScreen;
  1545.       GotoXY(X,Y);
  1546.  
  1547.     END { if NTraded > 0 }
  1548.   ELSE BEGIN
  1549.  
  1550.     { no Equipment to sell, so split }
  1551.  
  1552.     SelectWindow(2);
  1553.     RestoreScreen;
  1554.     GoToXY(X,Y);
  1555.     SaveScreen(X,Y);
  1556.     TextColor(White);
  1557.     TextBackground(Red);
  1558.     GoToXY(10,10);WriteLn('                                      ');
  1559.     GoToXY(10,11);WriteLn(' Equipment is not bought at this port ');
  1560.     GoToXY(10,12);WriteLn('                                      ');
  1561.     Delay(3000);
  1562.     NormalVideo;
  1563.     RestoreScreen;
  1564.     GoToXY(X,Y);
  1565.   END;
  1566. END;
  1567.  
  1568. {
  1569.   this is a new experimental multistealing algorithm;
  1570.   the idea is to get a more efficient steal/sell cycle
  1571.   for those individuals who can only steal a few holds
  1572.   but have many holds on their ships, say, an individual
  1573.   with 989 exp and a 250 hold colonial transport.  By
  1574.   stealing repeatedly until the ship is filled, you save
  1575.   sell turns, and buy selling more at once, increase your
  1576.   odds of getting a 5 point sale.  Simply put, this
  1577.   algorithm makes more money than a traditional 5 point
  1578.   algorithm under certain conditions.
  1579. }
  1580.  
  1581. Procedure MultiSteal;
  1582. Const
  1583.   Risk = 0.0333333333; { assuming 1/30 chance of getting caught }
  1584.  
  1585. Var
  1586.   Port1Buy, Port2Buy, ExpStr : String;
  1587.   P1b, P1s : real3;
  1588.   P1F : Real3;
  1589.   NTraded, MaxNBought : integer;
  1590.   P1_4Sale,P2_4Sale : integer;
  1591.   P1Haggle, P2Haggle : Integer;
  1592.   P1Buy, P2Buy : integer;
  1593.   TotHolds,SumHolds : integer;
  1594.   Bp5p , Fo5p : integer;
  1595.   Holds : Int3;
  1596.   Loop : Boolean;
  1597.   HasSold : Boolean;
  1598.   X,Y,i : integer;
  1599.   experience, MostEff, EffHolds,ec1 : integer;
  1600.   eff,neweff,rtemp : real;
  1601.   OneMinusRisk, lnOMR, NRisk : real;
  1602.   holdspt, newholds, maxcyc, nturns, turns, xsteal : integer;
  1603.   StealHolds : integer;
  1604.  
  1605.  
  1606. BEGIN
  1607.   OneMinusRisk := 1.0 - Risk;
  1608.   lnOMR := ln(OneMinusRisk);
  1609.   SaveScreen(X,Y);
  1610.   Window(5,5,40,15);
  1611.   YellowVideo;
  1612.   ClrScr;
  1613.   Loop := TRUE;
  1614.   for i := 1 to 3 do begin
  1615.     { none of these are used but it keeps process_port_pair happy }
  1616.     P1F[i] := DefaultFactor;
  1617.     P1B[i] := DefaultBuy;
  1618.     P1S[i] := DefaultSell;
  1619.   end;
  1620.   WriteLn('  Multi Steal/Sell: ');
  1621.     Write('         Port Type: ');
  1622.   ReadLn(Port1Buy);
  1623.   { if somebody enters a port class, convert it to the 3 char string }
  1624.   If ((length(Port1Buy) = 1) and (isdigit(Port1Buy[1]))) then
  1625.     Port1Buy := ClassStr[Ord(Port1Buy[1]) - Ord('0')];
  1626.   Port2Buy := Port1Buy;
  1627.   Port2Buy[3] := 'S';
  1628.   { Finding out how many products we can "trade" }
  1629.  
  1630.   Process_Port_Pair(Port1Buy,Port2Buy,NTraded,P1Buy,P2Buy,
  1631.                     P1Haggle,P2Haggle,P1_4Sale,P2_4Sale);
  1632.  
  1633.   { if we can sell equipment to this port, then steal }
  1634.   If (NTraded > 0) THEN
  1635.     BEGIN
  1636.       Write('  Your Experience : ');
  1637.       BuildString(ExpStr);WriteLn;
  1638.       Write(' How many Holds to Trade with : ');
  1639.       ReadLn(TotHolds);
  1640.       experience := 0;
  1641.       If (Length(ExpStr) > 0) then begin
  1642.         Val(ExpStr,experience,ec1);
  1643.         if (ec1 <> 0) then
  1644.           experience := 0;
  1645.       end;
  1646.       if (experience > 0) then begin
  1647.         rtemp := experience / 100;
  1648.         holdspt := round(5*rtemp); { round to nearest 5 holds of exp/20 }
  1649.         if (holdspt >= totholds) then begin
  1650.           stealholds := totholds;
  1651.           mosteff := 1;
  1652.           {
  1653.             trading efficiency = (holds sold per turn - risk*#holds that can
  1654.             be lost per turn - risk*loss of holds that could be stolen with
  1655.             lost experience per turn)
  1656.           }
  1657.           eff := (stealholds - Risk*(stealholds + experience/200))
  1658.                  /(mosteff + 1.0);
  1659.         end
  1660.         else begin
  1661.           maxcyc := totholds div holdspt + 1;
  1662.           mosteff := 0;
  1663.           eff := 0.0;
  1664.           stealholds := 0;
  1665.           for turns := 1 to maxcyc do begin
  1666.             NRisk := 1.0 - exp(turns*lnOMR);
  1667.             nturns := turns + 1;
  1668.             if (turns*holdspt > TotHolds) then
  1669.               newholds := TotHolds div turns
  1670.             else newholds := holdspt;
  1671.             { ok, how efficient is this potential loop? }
  1672.             {
  1673.               efficiency = turns*holds/# turns for loop -
  1674.                            cumulative risk for loop turns * (
  1675.                            mean number of holds to be lost +
  1676.                            holds equivalent to 10% of exp)/
  1677.                            # turns for loop
  1678.             }
  1679.             neweff := (turns*newholds - NRisk*
  1680.                       (newholds*(turns+1)/2 + experience/200))/nturns;
  1681.             if (neweff > eff) then begin
  1682.               mosteff := turns;
  1683.               eff := neweff;
  1684.               stealholds := newholds;
  1685.             end;
  1686.           end; { for turns }
  1687.         end;
  1688.       end
  1689.       else begin
  1690.         StealHolds := TotHolds;
  1691.         MostEff := 1;
  1692.         eff := stealholds*(1 - Risk)/(mosteff + 1.0);
  1693.       end;
  1694.       For i := 1 to 3 do begin
  1695.         If i = 3 then
  1696.           Holds[i] := StealHolds*MostEff
  1697.         else Holds[i] := 0;
  1698.       end;
  1699.       Writeln(' Stealing ',StealHolds:3,' Holds for ');
  1700.       WriteLn(' ',MostEff:1,' Consecutive Turns.');
  1701.       WriteLn(' Eff = ',Eff:7:2,' holds/turn.');
  1702.       Delay(2500);
  1703.       NormalVideo;
  1704.       SelectWindow(2);
  1705.       RestoreScreen;
  1706.       GoToXY(X,Y);
  1707.       { notify user Stealing Macro is active }
  1708.       TextColor(White);
  1709.       TextBackground(Cyan);
  1710.       SelectWindow(1);
  1711.       ClrScr;
  1712.       Write('      === ALT 6 - MultiSteal Steal/Sell. ALT Q Quits. ===      ');
  1713.       NormalVideo;
  1714.       SelectWindow(2);
  1715.       GoToXY(X,Y);
  1716.  
  1717.       { stealing loop }
  1718.       BP5P := 0;
  1719.       FO5P := 0;
  1720.       HasSold := FALSE;
  1721.       REPEAT
  1722.       { Trade until a user types ALT-Q or routine hits exit condition}
  1723.       xsteal := 0;
  1724.       While ((xsteal < Mosteff) and Loop) do begin
  1725.         StealAtAPort(Loop,HasSold,StealHolds,SMulti);
  1726.         Inc(xsteal);
  1727.       end;
  1728.       If Loop then begin
  1729.         FivePointTrade(Port1Buy,P1_4Sale,BP5P,Fo5p,Holds,P1Haggle,Loop);
  1730.         HasSold := TRUE;
  1731.       end;
  1732.       UNTIL NOT Loop;
  1733.       SaveScreen(X,Y);
  1734.       TextColor(Yellow);
  1735.       TextBackground(Blue);
  1736.       GoToXY(10,10);WriteLn('                     ');
  1737.       GoToXY(10,11);WriteLn(' Exiting STEAL Macro ');
  1738.       GoToXY(10,12);WriteLn('                     ');
  1739.       Delay(3000);
  1740.       NormalVideo;
  1741.       RestoreScreen;
  1742.       GotoXY(X,Y);
  1743.  
  1744.     END { if NTraded > 0 }
  1745.   ELSE BEGIN
  1746.  
  1747.     { no Equipment to sell, so split }
  1748.  
  1749.     SelectWindow(2);
  1750.     RestoreScreen;
  1751.     GoToXY(X,Y);
  1752.     SaveScreen(X,Y);
  1753.     TextColor(White);
  1754.     TextBackground(Red);
  1755.     GoToXY(10,10);WriteLn('                                      ');
  1756.     GoToXY(10,11);WriteLn(' Equipment is not bought at this port ');
  1757.     GoToXY(10,12);WriteLn('                                      ');
  1758.     Delay(3000);
  1759.     NormalVideo;
  1760.     RestoreScreen;
  1761.     GoToXY(X,Y);
  1762.   END;
  1763. END;
  1764.  
  1765. BEGIN
  1766.   { initialize buy and sell margins and trading factor }
  1767.   DefaultBuy := 0.96;
  1768.   DefaultSell := 1.04;
  1769.   DefaultFactor := 2.3333333; { equal to f = 0.3 in 2nd order theory }
  1770.   DeltaFactorOffer := 25;
  1771.   DeltaFactorPsp := 4;
  1772. END.
  1773.